home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #260 (1993)(Rhein-Sieg-Soft).zip / Franz PD Disk #260 (1993)(Rhein-Sieg-Soft).adf / CASSLI / CassLi (.txt) < prev    next >
AmigaBASIC Source Code  |  1993-08-06  |  18KB  |  686 lines
  1. REM  *** Tonträgerverwaltung von ***
  2. REM  ******** HP Biehl 1992 ********
  3. REM  *** Version 1.2 (21.08.93) ****
  4. anfang:
  5.  DIM cahin(151),cahil(151),sdn(151),scadur(151),sip(151)
  6.  DIM ino(151),il(151),sidn(151),sicadur(151),sil(151)
  7.  PALETTE 0,0.1,0.1,0.1
  8.  PALETTE 1,0.55,0.35,0.98
  9.  PALETTE 2,0.8,0.1,0.1
  10.  OPEN"R",#1,"cass",9
  11.  FIELD #1,3 AS i$,4 AS l$,2 AS n$
  12.  OPEN"R",#2,"interp",18
  13.  FIELD #2,18 AS inte$
  14.  OPEN"R",#3,"cassetli",28
  15.  FIELD #3,28 AS ca$
  16.  OPEN"I",#4,"CassAnz"
  17.  INPUT #4,CasMax:INPUT #4,IntMax
  18.  CLOSE 4
  19. Menue:
  20.  COLOR 1,0:CLS:PRINT
  21.  PRINT " 1 = Interpretenliste erweitern/ändern/anzeigen"
  22.  PRINT " 2 = Cassettenliste erweitern/ändern/anzeigen"
  23.  COLOR 2,0
  24.  PRINT " 3 = Interpret + Benotung je Song"
  25.  COLOR 1,0
  26.  PRINT " 4 = Maximale Interpreten- bzw. Cassettenzahl vergrößern"
  27.  COLOR 3,0
  28.  PRINT " 5 = Cassetten-Hitliste"
  29.  PRINT " 6 = Interpreten-Hitliste"
  30.  COLOR 1,0
  31.  PRINT " 7 = Interpretenliste nach Anfangsbuchstaben"
  32.  COLOR 3,0
  33.  PRINT " 8 = Interpreten suchen"
  34.  COLOR 1,0
  35.  PRINT " 9 = Ende"
  36.  COLOR 2,0
  37. Menuauswahl: 
  38.  LOCATE 12,1:INPUT " Auswahl (? = Infos): ",ausw$
  39.  IF ausw$="?" THEN Hauptinfos
  40.  ausw=VAL(ausw$)
  41.  IF ausw<1 OR ausw>9 THEN Menue
  42.  cano=0
  43.  ON ausw GOSUB interli,casseli,ausdatei,datein,casshi,ihi,inalpha,ISu,ende                
  44.  GOTO Menue
  45. Hauptinfos:
  46.  WINDOW 2," HILFEMENÜ",,2
  47.  COLOR 3,0 
  48.  PRINT " Es werden immer nur Cassetten erwähnt. Mit LPs oder CDs läuft die ganze"
  49.  PRINT " Geschichte natürlich auch. Um alle Funktionen kennenzulernen ist es anfangs"
  50.  PRINT " ratsam, immer wenn eine Eingabe verlangt wird, ? einzugeben!"
  51.  PRINT:COLOR 2,0
  52.  PRINT " 1 = Interpretenliste erweitern/ändern/anzeigen"
  53.  COLOR 1,0:PRINT " Zur stapelweisen Erfassung bzw. Änderung auf den Tonträgern vorkommender"
  54.  PRINT " Interpreten inkl. Anzeige. Einzelerfassung auch direkt im Menüpunkt 3 möglich!"
  55.  COLOR 2,0
  56.  PRINT " 2 = Cassettenliste erweitern/ändern/anzeigen"
  57.  COLOR 1,0:PRINT " Zur stapelweisen Erfassung bzw. Änderung von Tonträgern inkl. Anzeige."
  58.  PRINT " Einzelerfassung auch direkt im Menüpunkt 3 möglich!"
  59.  COLOR 2,0
  60.  PRINT " 3 = Interpret + Benotung je Song"
  61.  COLOR 1,0:PRINT " Zu den einzelnen Songs eines bestimmten Tonträgers den Interpreten, die Note"
  62.  PRINT " und die Länge in Sekunden eingeben. Je Tonträger maximal 35 Songs! Noten"
  63.  PRINT " können von 1-99 vergeben werden, wobei kleinere Zahlen bessere Noten bedeuten."
  64.  PRINT " (10 ist z. B. besser als 20)
  65.  COLOR 2,0
  66.  PRINT " 4 = Maximale Interpreten- bzw. Cassettenzahl vergrößern"
  67.  COLOR 1,0:PRINT " Diese sind aus Rechenzeitersparnis begrenzt und können hier bei Bedarf"
  68.  PRINT " jederzeit erhöht werden."
  69.  COLOR 2,0
  70.  PRINT " 5 = Cassetten-Hitliste"
  71.  COLOR 1,0:PRINT " Die Rangfolge aller Tonträger nach Deiner unter Menüpunkt 3 gegebenen"
  72.  PRINT " Benotung wird hier ermittelt und aufgelistet."
  73.  COLOR 3,0:PRINT " Weiter mit beliebiger Taste"
  74.  WHILE INKEY$="":WEND
  75.  PRINT :COLOR 2,0
  76.  PRINT " 6 = Interpreten-Hitliste"
  77.  COLOR 1,0:PRINT " Die Rangfolge aller Interpreten nach Deiner unter Menüpunkt 3 gegebenen"
  78.  PRINT " Benotung wird hier ermittelt und aufgelistet (benötigt etwas Rechenzeit)." 
  79.  COLOR 2,0
  80.  PRINT " 7 = Interpretenliste nach Anfangsbuchstaben"
  81.  COLOR 1,0:PRINT " Nach wahlweisen Anfangsbuchstaben sortierte Ausgabe der Interpreten. Dazu ist"
  82.  PRINT " es wichtig, daß im Menüpunkt 1 bzw. 3 die Namen der Interpreten mit einem"
  83.  PRINT " Großbuchstaben beginnend erfaßt wurden und ggfls. mit dem Nachnamen zuerst."
  84.  COLOR 2,0
  85.  PRINT " 8 = Interpreten suchen"
  86.  COLOR 1,0:PRINT " Auflistung aller Tonträger, auf dem sich ein Interpret nach Wahl befindet."
  87.  COLOR 2,0
  88.  PRINT " 9 = Ende"
  89.  COLOR 1,0:PRINT " Verlassen des Programms"
  90.  COLOR 2,0:PRINT 
  91.  PRINT  " Viel Vergnügen wünscht  Hans-Peter Biehl"
  92.  PRINT  "                         Dorfstr. 175"
  93.  PRINT  "                         6612 Schmelz-Limbach"
  94.  PRINT :COLOR 3,0:PRINT " Weiter mit beliebiger Taste"
  95.  WHILE INKEY$="":WEND
  96.  WINDOW CLOSE 2:GOTO Menue
  97. anza:
  98.   PRINT 
  99.   COLOR 1,0:INPUT " Von Cassetten-Nr.",x$
  100.   IF x$="?" THEN 
  101.     COLOR 2,0
  102.     PRINT " Gib die kleinste für die Ermittlung zu berücksichtigende Cass.-Nr. ein!"
  103.     COLOR 1,0
  104.   END IF
  105.   x=VAL(x$)
  106.   IF x<1 THEN anza
  107.   IF x>CasMax THEN 
  108.     GOSUB Caszugross
  109.     GOTO anza
  110.   END IF
  111. bisanza:  
  112.   COLOR 1,0:INPUT " bis Cassetten-Nr.",xx$
  113.   IF xx$="?" THEN 
  114.     COLOR 2,0
  115.     PRINT " Gib die größte für die Ermittlung zu berücksichtigende Cass.-Nr. ein!"
  116.     COLOR 1,0:GOTO bisanza
  117.   END IF 
  118.   xx=VAL(xx$)
  119.   IF xx<x THEN bisanza
  120.   IF xx>CasMax THEN 
  121.     GOSUB Caszugross
  122.     GOTO bisanza
  123.   END IF
  124.   PRINT :RETURN
  125. Caszugross:
  126.   COLOR 2,0
  127.   PRINT " Darf ich Dich erinnern, daß die maximale Cassettenanzahl";CasMax;"beträgt?"
  128.   RETURN
  129. datein:
  130.  CLS:PRINT:COLOR 2,0 
  131.  PRINT " Maximale Anzahl Cassetten:   ";CasMax
  132.  PRINT " Maximale Anzahl Interpreten: ";IntMax
  133.  PRINT : COLOR 1,0
  134.  PRINT  " 1 = Erläuterungen (bitte zuerst anwählen)"
  135.  PRINT  " 2 = Maximale Cassettenanzahl vergrößern"
  136.  PRINT  " 3 = Maximale Interpretenanzahl vergrößern" 
  137.  PRINT  " 4 = Hauptmenü"
  138.  PRINT : COLOR 3,0 
  139. Auswahl: 
  140.  INPUT  " Auswahl ",ausw$
  141.  IF ausw$="?" THEN PRINT  " Für Infos 1 eingeben!":GOTO Auswahl
  142.  ausw=VAL(ausw$)
  143.  IF ausw<1 OR ausw>4 THEN datein
  144.  ON ausw GOSUB infos,ceinri,ieinri
  145.  IF ausw=4 THEN RETURN
  146.  GOTO datein
  147. ausdatei:
  148.   CLS:COLOR 2,0:INPUT " Cassetten-Nr. ",cas$
  149.   cano=0
  150.   IF cas$="?" THEN
  151.     WINDOW 2," Eingabemöglichkeiten",,2
  152.     PRINT :PRINT " .......   (Nr. der zu benotenden Cassette)"
  153.     PRINT "   bzw.    (Cassettenliste erweitern/ändern/anzeigen)"
  154.     PRINT "           (zurück ins Hauptmenü)"
  155.     PRINT "           (diese Anzeige)"
  156.     COLOR 2,0
  157.     LOCATE 2,2:PRINT "1":LOCATE 2,6:PRINT CasMax
  158.     LOCATE 3,2:PRINT "C":LOCATE 3,9:PRINT "c"
  159.     LOCATE 4,2:PRINT "<RETURN>"
  160.     LOCATE 5,5:PRINT "?"
  161.     COLOR 3,0
  162.     PRINT :PRINT " Das Drücken einer beliebigen Taste führt Dich nun wieder in die"
  163.     PRINT " Eingabemaske."
  164.     COLOR 1,0:LOCATE 2,6:PRINT "."
  165.     WHILE INKEY$="":WEND
  166.     WINDOW CLOSE 2
  167.     GOTO ausdatei
  168.   END IF
  169.   IF cas$="c" OR cas$="C" THEN cano=1:GOTO casseli
  170.   cas%=VAL(cas$)
  171.   IF cas%=0 OR cas%>CasMax THEN RETURN
  172.   GET #3,cas%:LOCATE 1,19:PRINT  ": ";ca$ 
  173.   PRINT  " ------------------":COLOR 3,0
  174.   PRINT  " Song Interpret    sec.  Note        Song Interpret    sec.  Note"
  175.   COLOR 1,0
  176.   FOR code=cas%*35-34 TO cas%*35
  177.   GET #1,code
  178.   IF CVI(i$)>0 THEN
  179.    lo2=1:lo1=code-cas%*35+38
  180.    IF code-cas%*35+19>0 THEN lo1=code-cas%*35+22:lo2=37
  181.    GET #2,CVI(i$)
  182.    LOCATE lo1,lo2:PRINT USING " ##)  \         \ ####    ##";code-cas%*35+35;inte$;CVI(l$);CVI(n$)
  183.   END IF   
  184.   NEXT code  
  185. SongNot:  
  186.   LOCATE 20,1:COLOR 3,0:INPUT " Song-Nr.: ",tit$
  187.   IF tit$="?" THEN 
  188.     LOCATE 20,1
  189.     INPUT " Gib die Song-Nr. (1-35) ein oder RETURN für zurück: ",tit$
  190.   END IF  
  191.   tit%=VAL(tit$)
  192.   IF tit%>35 THEN 
  193.     LOCATE 20,12:PRINT  "                                             "
  194.     GOTO SongNot
  195.   END IF
  196.   IF tit%=0 THEN RETURN
  197. IntNot:  
  198.   LOCATE 21,1
  199.   INPUT " Interpreter-Nr.: ",in$
  200.   IF in$="?" THEN
  201.     WINDOW 2," Eingabemöglichkeiten",,2
  202.     PRINT :PRINT " .......   (Nr. des Interpreten)"
  203.     PRINT "   bzw.    (Interpretenliste erweitern/ändern/anzeigen)"
  204.     PRINT "           (zurück ins Hauptmenü)"
  205.     PRINT "           (diese Anzeige)"
  206.     COLOR 2,0
  207.     LOCATE 2,2:PRINT "1":LOCATE 2,6:PRINT IntMax
  208.     LOCATE 3,2:PRINT "I":LOCATE 3,9:PRINT "i"
  209.     LOCATE 4,2:PRINT "<RETURN>"
  210.     LOCATE 5,5:PRINT "?"
  211.     COLOR 3,0
  212.     PRINT :PRINT " Das Drücken einer beliebigen Taste führt Dich nun wieder in die"
  213.     PRINT " Eingabemaske."
  214.     COLOR 1,0:LOCATE 2,6:PRINT "."
  215.     WHILE INKEY$="":WEND
  216.     WINDOW CLOSE 2
  217.     GOTO IntNot
  218.   END IF  
  219.   IF in$="I" OR in$="i" THEN 
  220.     cano=2:GOTO interli
  221.   END IF
  222.   in%=VAL(in$)
  223.   IF in%>IntMax THEN IntNot
  224.   LSET i$=MKI$(in%)
  225. SecNot:  
  226.   seku=0
  227.   LOCATE 22,1:INPUT " Sekunden (t=Stoppuhr): ",la$
  228.   IF la$="?" THEN
  229.     WINDOW 2," Sekundeneingabe",,2
  230.     CLS:PRINT 
  231.     PRINT " Gib die Anzahl der Sekunden dieses Songs ein oder"
  232.     PRINT " gib t ein, um die Stoppuhrfunktion aufzurufen. Die Stoppuhr"
  233.     PRINT " wird jeweils mit der Leertaste gestartet und gestoppt."
  234.     PRINT " Die Sekunden laufen auf dem Bildschirm mit."
  235.     PRINT " Doch zunächst drücke eine beliebige Taste, um zur Eingabemaske"
  236.     PRINT " zurückzukehren!"
  237.     WHILE INKEY$="":WEND
  238.     WINDOW CLOSE 2
  239.     GOTO SecNot
  240.   END IF
  241.   IF la$="t" OR la$="T" THEN
  242.     la$="1"
  243.     LOCATE 22,2:PRINT "LEERTASTE startet die Stoppuhr!"
  244.     WHILE INKEY$<>" ":WEND
  245.     seku1=TIMER
  246.     LOCATE 22,2:PRINT "Sekunden:      (Stopp durch LEERTASTE)"
  247.     WHILE INKEY$<>" "
  248.      seku=TIMER-seku1
  249.      LOCATE 22,11:PRINT USING "####";seku
  250.     WEND
  251.     LOCATE 22,17:PRINT "                       "
  252.   END IF
  253.   IF VAL(la$)>0 THEN la%=VAL(la$) :ELSE SecNot
  254.   IF seku>0 THEN la%=seku
  255.   LSET l$=MKI$(la%)
  256. NotNot:  
  257.   LOCATE 23,1:INPUT " Note: ",no$
  258.   IF no$="?" THEN 
  259.     LOCATE 23,1:INPUT " Gib eine Note (1-99) ein. Je kleiner, desto besser:",no$
  260.   END IF  
  261.   no%=VAL(no$)
  262.   IF no%<1 OR no%>99 THEN NotNot
  263.   LSET n$=MKI$(no%)
  264. indatei: 
  265.   code=cas%*35-35+tit%
  266.   PUT #1,code
  267.   GOTO ausdatei
  268. infos:
  269.   COLOR 2,0:PRINT 
  270.   PRINT " Es ist ratsam, die maximale Anzahl Cassetten und Interpreten"
  271.   PRINT " immer nur stufenweise etwas zu erhöhen, um zu verhindern, daß"
  272.   PRINT " die einzelnen Programmpunkte unnötig lange Rechenzeiten in"
  273.   PRINT " Anspruch nehmen. Beachte, daß verkleinern nicht mehr geht,"
  274.   PRINT " immer nur vergrößern!"
  275.   COLOR 3,0:PRINT 
  276.   PRINT " Weiter mit beliebiger Taste!"
  277.   WHILE INKEY$="":WEND
  278.   RETURN
  279. ieinri:
  280.   PRINT 
  281.   INPUT " Wie hoch soll die max. Interpretenanzahl sein";IntMax1$
  282.   IF IntMax1$="?" THEN 
  283.     PRINT " Gib eine Zahl größer als";IntMax;" ein."
  284.     GOTO ieinri
  285.   END IF
  286.   IntMax1=VAL(IntMax1$)
  287.   IF IntMax1<=IntMax THEN
  288.     PRINT " Das geht nicht!"
  289.     FOR w=1 TO 3000:NEXT w
  290.     RETURN
  291.   END IF
  292.   INPUT " Ganz wirklich (ja=j)";w$
  293.   IF w$<>"j" THEN 
  294.     PRINT " Also nicht!"
  295.     FOR w=1 TO 3000:NEXT w
  296.     RETURN
  297.   END IF
  298.   IntMaxAlt=IntMax:IntMax=IntMax1
  299.   OPEN"O",#4,"CassAnz"
  300.   PRINT #4,CasMax:PRINT #4,IntMax
  301.   CLOSE 4
  302.   LSET inte$=""
  303.   FOR i=IntMaxAlt+1 TO IntMax
  304.   PUT #2,i
  305.   NEXT:RETURN
  306. ceinri:
  307.   PRINT 
  308.   INPUT " Wie hoch soll die max. Cassettenanzahl sein";CasMax1$
  309.   IF CasMax1$="?" THEN 
  310.     PRINT " Gib eine Zahl größer als";CasMax;" ein."
  311.     GOTO ceinri
  312.   END IF
  313.   CasMax1=VAL(CasMax1$)
  314.   IF CasMax1<=CasMax THEN
  315.     PRINT " Das geht nicht!"
  316.     FOR w=1 TO 3000:NEXT w
  317.     RETURN
  318.   END IF
  319.   INPUT " Ganz wirklich (ja=j)";w$
  320.   IF w$<>"j" THEN 
  321.     PRINT " Also nicht!"
  322.     FOR w=1 TO 3000:NEXT w
  323.     RETURN
  324.   END IF
  325.   CasMaxAlt=CasMax:CasMax=CasMax1
  326.   OPEN"O",#4,"CassAnz"
  327.   PRINT #4,CasMax:PRINT #4,IntMax
  328.   CLOSE 4
  329.   LSET ca$=""
  330.   FOR i=CasMaxAlt+1 TO CasMax
  331.   PUT #3,i
  332.   NEXT i
  333.   LSET i$=CHR$(255)
  334.   FOR i=35*CasMaxAlt+1 TO 35*CasMax
  335.   PUT #1,i
  336.   NEXT
  337.   RETURN
  338. interli: 
  339.   WINDOW 2,"   Nr. Interpret                 Nr. Interpret",,2 
  340. interlis:
  341.   canza=0:acanz=0:COLOR 2,0
  342.   FOR i=1 TO IntMax
  343.   GET #2,i
  344.   IF inte$<>"                  " THEN
  345.    canza=canza+1:iloc1=canza:iloc2=1
  346.    IF canza>40 THEN iloc1=canza-40
  347.    IF canza>80 THEN iloc1=canza-80
  348.    IF canza>120 THEN iloc1=canza-120
  349.    IF canza>20 AND canza<41 THEN iloc1=canza-20:iloc2=31
  350.    IF canza>60 AND canza<81 THEN iloc1=canza-60:iloc2=31
  351.    IF canza>100 AND canza<121 THEN iloc1=canza-100:iloc2=31
  352.    LOCATE iloc1,iloc2                                  
  353.    PRINT USING "   ### \                 \";i;inte$
  354.   END IF
  355.   IF canza=40 OR canza=80 OR canza=120 THEN
  356.     acanz=canza
  357.     PRINT : COLOR 1,0
  358.     INPUT "    Weiter -> RETURN",w$
  359.     CLS:COLOR 2,0 
  360.   END IF  
  361.   NEXT i
  362.   PRINT :COLOR 3,0
  363. IntEin:  
  364.   LOCATE 21,1:PRINT "                                                               "
  365.   LOCATE 22,1:PRINT "                                                               "
  366.   LOCATE 21,1:INPUT "    Interpreten-Nr.:",in$
  367.   IF in$="?" THEN 
  368.     COLOR 1,0:LOCATE 21,1
  369.     PRINT "    Gib die Nr. des neuen bzw. des zu ändernden Interpreten ein"
  370.     PRINT "    oder einfach nur RETURN, um die Anzeige zu beenden!"
  371.     FOR wart=1 TO 7000:NEXT wart
  372.     COLOR 3,0
  373.     GOTO IntEin
  374.   END IF 
  375.   in=VAL(in$)
  376.   IF in=0 THEN 
  377.      WINDOW CLOSE 2
  378.      IF cano=2 THEN IntNot
  379.      IF cano=3 THEN ISu
  380.      RETURN
  381.   END IF
  382.   IF in>IntMax THEN 
  383.     COLOR 1,0:PRINT  " Darf ich Dich daran erinnern, daß die maximale Interpreten-Nr.";IntMax;"beträgt?"
  384.     COLOR 3,0
  385.     GOTO IntEin
  386.   END IF  
  387.   LOCATE 22,1:LINE INPUT "    Interpret: ",ip$
  388.   LSET inte$=ip$
  389.   PUT #2,in
  390.   IF cano=2 THEN
  391.    WINDOW CLOSE 2:GOTO IntNot
  392.   END IF
  393.   IF cano=3 THEN WINDOW CLOSE 2:GOTO ISu
  394.   GOTO interlis  
  395. inalpha:
  396.   WINDOW 2,"Interpretenliste nach Anfangsbuchstaben",,2
  397. inalf:  
  398.   CLS:COLOR 1,0:PRINT 
  399.   PRINT " Von Buchstabe ";
  400. bu1:  
  401.   alf1$=INKEY$:IF alf1$="" THEN bu1
  402.   COLOR 3,0:PRINT alf1$
  403.   IF alf1$="?" THEN
  404.     PRINT " Groß- oder Kleinbuchstabe, ist egal."
  405.     PRINT " Weiter mit beliebiger Taste!"
  406.     WHILE INKEY$="":WEND
  407.     GOTO inalf
  408.   END IF 
  409.   COLOR 1,0:PRINT " bis Buchstabe ";
  410. bu2:  
  411.   alf2$=INKEY$:IF alf2$="" THEN bu2
  412.   COLOR 3,0:PRINT alf2$
  413.   PRINT:alf1$=UCASE$(alf1$):alf2$=UCASE$(alf2$) 
  414.   alf1=ASC(alf1$):alf2=ASC(alf2$)
  415.   IF alf1<65 OR alf1>90 OR alf2<65 OR alf2>90 THEN
  416.     GOTO inalf
  417.   END IF
  418.   IF alf1>alf2 THEN alf=alf2:alf2=alf1:alf1=alf
  419.   COLOR 2,0
  420.   FOR alf=alf1 TO alf2
  421.   FOR i=1 TO IntMax
  422.   GET #2,i
  423.   IF CHR$(alf)=LEFT$(inte$,1) THEN
  424.    PRINT USING "### \                 \";i;inte$
  425.   END IF
  426.   NEXT i
  427.   NEXT alf
  428.   COLOR 1,0
  429.   PRINT :PRINT " Weiter mit beliebiger Taste"
  430.   WHILE INKEY$="":WEND
  431.   WINDOW CLOSE 2:RETURN
  432. ISu:
  433.   CLS:cano=0:INPUT " Interpreten-Nr.: ",in$
  434.   IF in$="I" OR in$="i" THEN cano=3:GOTO interli
  435.   IF in$="?" THEN
  436.     WINDOW 2," Eingabemöglichkeiten",,2
  437.     PRINT :PRINT " .......   (Nr. des zu suchenden Interpreten)"
  438.     PRINT "   bzw.    (Interpretenliste erweitern/ändern/anzeigen)"
  439.     PRINT "           (zurück ins Hauptmenü)"
  440.     PRINT "           (diese Anzeige)"
  441.     COLOR 2,0
  442.     LOCATE 2,2:PRINT "1":LOCATE 2,6:PRINT IntMax
  443.     LOCATE 3,2:PRINT "I":LOCATE 3,9:PRINT "i"
  444.     LOCATE 4,2:PRINT "<RETURN>"
  445.     LOCATE 5,5:PRINT "?"
  446.     COLOR 3,0
  447.     PRINT :PRINT " Das Drücken einer beliebigen Taste führt Dich nun wieder in die"
  448.     PRINT " Eingabemaske."
  449.     COLOR 1,0:LOCATE 2,6:PRINT "."
  450.     WHILE INKEY$="":WEND
  451.     WINDOW CLOSE 2
  452.     GOTO ISu
  453.   END IF  
  454.   in=VAL(in$)
  455.   IF in=0 OR in>IntMax THEN RETURN
  456.   GET #2,in
  457.   COLOR 3,0:PRINT 
  458.   LOCATE 1,23:PRINT inte$
  459.   COLOR 1,0:LOCATE 2,23
  460.   PRINT  "befindet sich auf:"
  461.   PRINT :COLOR 2,0
  462.   cadur=0
  463. cadurch:  
  464.   cadur=cadur+1
  465.   cassdu=0
  466. casdur:
  467.   cassdu=cassdu+1
  468.   cdg=(cadur-1)*35+cassdu
  469.   GET #1,cdg
  470.   hil=CVI(i$)
  471.   IF hil=in THEN
  472.     GET #3,cadur
  473.     PRINT  USING "### \                          \";cadur;ca$
  474.   END IF
  475.   IF hil=in THEN cadurch
  476.   IF cassdu<35 AND cadur<=CasMax THEN casdur
  477.   IF cadur<CasMax THEN cadurch 
  478.   COLOR 1,0:PRINT :INPUT " Weiter -> RETURN",w$
  479.   RETURN
  480. casseli:
  481.   WINDOW 2,"   Nr. Cassettentitel",,2 
  482. casselis:
  483.   canza=0:acanz=0:COLOR 2,0
  484.   FOR i=1 TO CasMax
  485.   GET #3,i
  486.   IF ca$<>"                            " THEN
  487.    canza=canza+1
  488.    PRINT USING "   ### \                           \";i;ca$
  489.   END IF
  490.   IF acanz<>canza AND (canza=20 OR canza=40 OR canza=60 OR canza=80 OR canza=100 OR canza=120 OR canza=140) THEN
  491.     acanz=canza
  492.     PRINT : COLOR 1,0
  493.     INPUT "    Weiter -> RETURN",w$
  494.     CLS:COLOR 2,0 
  495.   END IF  
  496.   NEXT i
  497.   PRINT :COLOR 3,0
  498. CasEin:  
  499.   INPUT "    Cassetten-Nr.: ",inc$
  500.   IF inc$="?" THEN
  501.     COLOR 1,0
  502.     PRINT "    Nur RETURN                      = Anzeige beenden"
  503.     PRINT "    Vorhandene Cass.-Nr.            = Name ändern"
  504.     PRINT "    Noch nicht vorhandene Cass.-Nr. = neu anlegen"
  505.     COLOR 3,0
  506.     GOTO CasEin
  507.   END IF
  508.   inc=VAL(inc$)
  509.   IF inc=0 THEN 
  510.     WINDOW CLOSE 2
  511.     IF cano=1 THEN ausdatei
  512.     RETURN
  513.   END IF
  514.   IF inc>CasMax THEN 
  515.     COLOR 1,0:PRINT "    Zu große Nr. !!!"
  516.     COLOR 3,0:GOTO CasEin
  517.   END IF
  518. CasTitEin:  
  519.   LINE INPUT "    Titel: ",casse$
  520.   IF casse$="?" THEN
  521.     PRINT " Maximal 28 Zeichen werden berücksichtigt!"
  522.     GOTO CasTitEin
  523.   END IF
  524.   LSET ca$=casse$
  525.   PUT #3,inc
  526.   IF cano=1 THEN 
  527.    WINDOW CLOSE 2: GOTO ausdatei
  528.   END IF
  529.   GOTO casselis  
  530. casshi:
  531.   GOSUB anza
  532.   COLOR 2,0:canza=0
  533.   FOR cadur=x TO xx
  534.   cahil(cadur)=0:cahin(cadur)=0:sdn(cadur)=0
  535.   FOR cadu=1 TO 35
  536.   cad=(cadur-1)*35+cadu
  537.   GET #1,cad
  538.   cil=CVI(i$)
  539.   IF cil>0 THEN
  540.    cahil(cadur)=cahil(cadur)+CVI(l$)
  541.    cahin(cadur)=cahin(cadur)+CVI(l$)*CVI(n$)
  542.   END IF
  543.   NEXT cadu
  544.   IF cahil(cadur)>0 THEN
  545.    GET #3,cadur
  546.    canza=canza+1
  547.    sdn(canza)=cahin(cadur)/cahil(cadur)
  548.    scadur(canza)=cadur
  549.   END IF
  550.   IF canza>1 THEN 
  551.    FOR sorti=canza TO 1 STEP -1
  552.      srti=sorti-1
  553.      IF sdn(sorti)<sdn(srti) THEN
  554.        sdn=sdn(srti)
  555.        sdn(srti)=sdn(sorti)
  556.        sdn(sorti)=sdn
  557.        scadur=scadur(srti)
  558.        scadur(srti)=scadur(sorti)
  559.        scadur(sorti)=scadur
  560.      END IF
  561.    NEXT sorti
  562.   END IF
  563.   NEXT cadur
  564.   WINDOW 2,"Rang     Cassettentitel               sec.  Note",,2
  565.   COLOR 2,0
  566.   FOR sorti=1 TO canza
  567.   cadur=scadur(sorti)
  568.   GET #3,cadur
  569.   PRINT  USING "###. ### \                          \ ####  ##.#";sorti;cadur;ca$;cahil(cadur);sdn(sorti)
  570.   IF sorti=20 OR sorti=40 OR sorti=60 OR sorti=80 THEN
  571.     COLOR 2,0:PRINT :INPUT " Weiter -> RETURN",w$
  572.     CLS
  573.   END IF  
  574.   NEXT sorti
  575.   COLOR 1,0:PRINT :INPUT " Weiter -> RETURN",w
  576.   WINDOW CLOSE 2
  577.   RETURN
  578. ihi:
  579.   COLOR 1,0:PRINT 
  580.   PRINT " Nach Qualität (1), Quantität (2) oder Punkten (3) sortiert? (Nach Punkten"
  581.   INPUT " werden sowohl Qualität als auch Quantität berücksichtigt) Eingabe: ",w$
  582.   IF w$="?" THEN 
  583.     COLOR 3,0:PRINT  " Gib 1, 2 oder 3 ein oder nur ENTER für zurück!"
  584.     ihi1=1:GOTO ihi
  585.   END IF
  586.   w=VAL(w$)
  587.   IF w<>1 AND w<>2 AND w<>3 THEN Menue
  588.   IF ihi1=0 THEN LOCATE 16,1 :ELSE PRINT 
  589.   COLOR 2,0
  590.   PRINT  " Du kannst Dir in der Zeit ein Bier holen gehen!           "
  591.   COLOR 3,0
  592.   badnote=0
  593.   FOR cadur=1 TO CasMax
  594.   il(cadur)=0:ino(cadur)=0
  595.   NEXT cadur
  596.   FOR cadu=1 TO 35*CasMax
  597.   GET #1,cadu
  598.   hil=CVI(i$)
  599.   IF cadu=17.5*CasMax THEN 
  600.    IF ihi1=0 THEN LOCATE 16,1 :ELSE PRINT 
  601.    PRINT  " Siehst Du, die halbe Wartezeit ist schon vorbei!         "
  602.   END IF
  603.   ihi1=0
  604.   IF hil>0 THEN 
  605.    il(hil)=il(hil)+CVI(l$)
  606.    ino(hil)=ino(hil)+CVI(l$)*CVI(n$)
  607.    IF CVI(n$)>badnote THEN badnote=CVI(n$)
  608.   END IF
  609.   NEXT cadu
  610.   COLOR 2,0
  611.   WINDOW 2,"   Rang Interpret           sec.  Note  Punkte",,2
  612.   PRINT : COLOR 3,0
  613.   PRINT "   Jetzt sortiere ich noch!"
  614.   ianza=0
  615.   FOR cadur=1 TO IntMax
  616.   GET #2,cadur
  617.   IF il(cadur)>0 THEN
  618.    ianza=ianza+1
  619.    sidn(ianza)=ino(cadur)/il(cadur)
  620.    sil(ianza)=il(cadur)
  621.    sicadur(ianza)=cadur
  622.    sip(ianza)=sil(ianza)*(badnote-sidn(ianza))/10
  623.   END IF 
  624.    IF ianza>1 AND w=1 THEN
  625.       FOR sorti=ianza TO 1 STEP -1
  626.       srti=sorti-1
  627.       IF sidn(sorti)<sidn(srti) THEN
  628.         sidn=sidn(srti):sil=sil(srti):sip=sip(srti)
  629.         sidn(srti)=sidn(sorti):sil(srti)=sil(sorti):sip(srti)=sip(sorti)
  630.         sidn(sorti)=sidn:sil(sorti)=sil:sip(sorti)=sip
  631.         sicadur=sicadur(srti)
  632.         sicadur(srti)=sicadur(sorti)
  633.         sicadur(sorti)=sicadur
  634.       END IF
  635.       NEXT sorti
  636.    END IF
  637.    IF ianza>1 AND w=2 THEN   
  638.       FOR sorti=ianza TO 1 STEP -1
  639.       srti=sorti-1
  640.       IF sil(sorti)<sil(srti) THEN
  641.         sidn=sidn(srti):sil=sil(srti):sip=sip(srti)
  642.         sidn(srti)=sidn(sorti):sil(srti)=sil(sorti):sip(srti)=sip(sorti)
  643.         sidn(sorti)=sidn:sil(sorti)=sil:sip(sorti)=sip
  644.         sicadur=sicadur(srti)
  645.         sicadur(srti)=sicadur(sorti)
  646.         sicadur(sorti)=sicadur
  647.       END IF
  648.       NEXT sorti
  649.    END IF
  650.    IF ianza>1 AND w=3 THEN   
  651.       FOR sorti=ianza TO 1 STEP -1
  652.       srti=sorti-1
  653.       IF sip(sorti)<sip(srti) THEN
  654.         sidn=sidn(srti):sip=sip(srti):sil=sil(srti)
  655.         sidn(srti)=sidn(sorti):sip(srti)=sip(sorti):sil(srti)=sil(sorti)
  656.         sidn(sorti)=sidn:sip(sorti)=sip:sil(sorti)=sil
  657.         sicadur=sicadur(srti)
  658.         sicadur(srti)=sicadur(sorti)
  659.         sicadur(sorti)=sicadur
  660.       END IF
  661.       NEXT sorti
  662.    END IF
  663.   NEXT cadur
  664.   COLOR 2,0:CLS
  665.   IF w>1 THEN 
  666.     ianza1=ianza:ianza2=1:ianza3=-1
  667.   ELSE
  668.     ianza1=1:ianza2=ianza:ianza3=1
  669.   END IF
  670.   FOR sorti=ianza1 TO ianza2 STEP ianza3
  671.   cadur=sicadur(sorti)
  672.   IF w>1 THEN sortie=ianza+1-sorti :ELSE sortie=sorti
  673.   GET #2,cadur
  674.   PRINT  USING "   ###. \                \ #####  ##.#  ######";sortie;inte$;sil(sorti);sidn(sorti);sip(sorti)
  675.   IF sortie=20 OR sortie=40 OR sortie=60 OR sortie=80 OR sortie=100 THEN
  676.     COLOR 3,0:PRINT :INPUT "    Weiter -> RETURN",w$
  677.     CLS:COLOR 2,0
  678.   END IF
  679.   NEXT sorti
  680.   COLOR 1,0:PRINT :INPUT "    Weiter -> RETURN",w$
  681.   WINDOW CLOSE 2
  682.   RETURN
  683. ende:
  684.   SYSTEM
  685.    
  686.